Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp4.arc / SENDKER2.PAS < prev next >

Wrap

Pascal/Delphi Source File | 1985-10-04 | 37.0 KB | 874 lines

(*----------------------------------------------------------------------*) (* Initialize_Send_Display --- Set up display of Kermit reception *) (*----------------------------------------------------------------------*) PROCEDURE Initialize_Send_Display; (*----------------------------------------------------------------------*) (* *) (* Procedure: Initialize_Send_Display *) (* *) (* Purpose: Initializes status display for Kermit transfers *) (* *) (* Calling Sequence: *) (* *) (* Initialize_Send_Display; *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Initialize_Send_Display *) GoToXY( 1 , 1 ); WRITE(' Packets sent :'); ClrEol; GoToXY( 1 , 2 ); WRITE(' Bytes sent :'); ClrEol; GoToXY( 1 , 3 ); WRITE(' Retries :'); ClrEol; GoToXY( 1 , 4 ); WRITE(' Bytes to send :'); ClrEol; GoToXY( 1 , 5 ); WRITE(' Last status message :'); ClrEol; END (* Initialize_Send_Display *); (*----------------------------------------------------------------------*) (* Get_Kermit_File_Name --- Construct file name to Kermit form *) (*----------------------------------------------------------------------*) PROCEDURE Get_Kermit_File_Name( VAR OK_File : BOOLEAN ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Get_Kermit_File_Name *) (* *) (* Purpose: Gets name of next file to be transferred *) (* *) (* Calling Sequence: *) (* *) (* Get_Kermit_File_Name( VAR OK_File : BOOLEAN ); *) (* *) (* OK_File --- TRUE if file is OK to be transferred *) (* *) (* Calls: *) (* *) (* Scan_Xfer_List *) (* *) (* Remarks: *) (* *) (* The global variable 'FileName' gets the file name. *) (* *) (*----------------------------------------------------------------------*) VAR I: INTEGER; BEGIN (* Get_Kermit_File_Name *) I := 1; FileName := ''; WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) AND ( I <= 12 ) DO BEGIN FileName := FileName + File_Entry.File_Name[I]; I := I + 1; END; OK_File := ( File_Entry.File_Attr AND ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 ); (* If host mode, make sure file *) (* is on xferlist! *) IF Host_Mode THEN OK_File := Scan_Xfer_List( FileName ); END (* Get_Kermit_File_Name *); (*----------------------------------------------------------------------*) (* Get_File_Data --- get data from file *) (*----------------------------------------------------------------------*) PROCEDURE Get_File_Data; (*----------------------------------------------------------------------*) (* *) (* Procedure: Get_File_Data *) (* *) (* Purpose: Gets next buffer of data from file being uploaded *) (* *) (* Calling Sequence: *) (* *) (* Get_File_Data; *) (* *) (* Calls: *) (* *) (* Read_File_Handle *) (* Close_File_Handle *) (* *) (* Remarks: *) (* *) (* The global variable 'Packet_Buffer_Data' gets the next batch *) (* of data. 'Read_Buffer^' holds the current 'Buffer_Size' *) (* characters read in. *) (* *) (*----------------------------------------------------------------------*) VAR Char_Count : INTEGER; Temp_8 : CHAR; Temp_7 : CHAR; B_Temp_8 : BYTE ABSOLUTE Temp_8; B_Temp_7 : BYTE ABSOLUTE Temp_7; Temp_Data : STRING[120]; End_Of_File : BOOLEAN; Err : INTEGER; NRead : INTEGER; Ascii_File : BOOLEAN; L : INTEGER; MaxData : INTEGER; BEGIN (* Get_File_Data *) (* Maximum length allowed for data *) MaxData := Kermit_Packet_Size - 3 - ( ORD( Kermit_Chk_Type ) - ORD('0') ); (* Remember if ascii transfer *) Ascii_File := ( Kermit_File_Type_Var = Kermit_Ascii ); (* Set data type packet *) Packet_Buffer_Data := 'D'; (* Characters from file *) Char_Count := 0; (* Not end of file yet *) End_Of_File := FALSE; (* Get next batch of characters *) (* from file *) REPEAT (* Check if we ran off end of *) (* buffer. If so, read more *) (* characters into buffer. *) IF ( Buffer_Pos >= Buffer_Size ) AND ( NOT End_Of_File ) THEN BEGIN (* Read Sector_size chars from file *) (* to be sent. *) NRead := Buffer_Size; Err := Read_File_Handle( XFile_Handle, Read_Buffer^, NRead ); Buffer_Pos := 0; Buffer_Size := NRead; End_Of_File := ( NRead <= 0 ); END; (* See if anything to be sent *) IF ( Buffer_Pos < Buffer_Size ) THEN BEGIN (* Pick up next character *) Buffer_Pos := Buffer_Pos + 1; B_Temp_8 := Read_Buffer^[ Buffer_Pos ]; B_Temp_7 := ( B_Temp_8 AND $7F ); Char_Count := Char_Count + 1; (* Quote the 8-bit quote if found *) IF Quoting THEN IF ( Temp_8 = Kermit_Quote_8_Char ) THEN Packet_Buffer_Data := Packet_Buffer_Data + Kermit_Quote_Char (* Perform 8th bit quoting *) ELSE IF ( B_Temp_8 > 127 ) THEN BEGIN Packet_Buffer_Data := Packet_Buffer_Data + Kermit_Quote_8_Char; Temp_8 := Temp_7; END; (* Perform control quoting *) IF ( B_Temp_8 < SP ) OR ( B_Temp_8 = DEL ) OR ( Temp_8 = Kermit_Quote_Char ) THEN BEGIN Packet_Buffer_Data := Packet_Buffer_Data + Kermit_Quote_Char; IF ( Temp_7 <> Kermit_Quote_Char ) THEN BEGIN B_Temp_7 := B_Temp_7 XOR 64; B_Temp_8 := B_Temp_8 XOR 64; END; END; (* Finally, insert either 8-bit or *) (* 7-bit version of character into *) (* packet. *) IF Ascii_File THEN Packet_Buffer_Data := Packet_Buffer_Data + Temp_7 ELSE Packet_Buffer_Data := Packet_Buffer_Data + Temp_8; END; (* Make sure to stop at ^Z = EOF *) (* on text files. *) IF Ascii_File AND ( Temp_7 = ^Z ) THEN BEGIN End_Of_File := TRUE; Buffer_Pos := Buffer_Size + 1; L := LENGTH( Packet_Buffer_Data ); IF ( L > 1 ) THEN Packet_Buffer_Data := COPY( Packet_Buffer_Data, 1, L - 1 ) ELSE Packet_Buffer_Data := ''; END; UNTIL ( End_Of_File AND ( Buffer_Pos >= Buffer_Size ) ) OR ( LENGTH( Packet_Buffer_Data ) >= MaxData ); (* Record character count *) Buffer_Num := Buffer_Num + Char_Count; (* Remember if end of file AND *) (* buffer exhausted. *) IF ( End_Of_File AND ( Buffer_Pos >= Buffer_Size ) ) THEN BEGIN File_Done := TRUE; Err := Close_File_Handle( XFile_Handle ); END ELSE File_Done := FALSE; END (* Get_File_Data *); (*----------------------------------------------------------------------*) (* Kermit_Send_Init --- send initialization packet *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_Init; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_Init *) (* *) (* Purpose: Sends transfer initialization packet to host. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_Init; *) (* *) (* Calls: *) (* *) (* Build_Packet *) (* Send_Packet *) (* Receive_Packet *) (* *) (*----------------------------------------------------------------------*) VAR Quote_8 : CHAR; Repeat_Char : CHAR; BEGIN (* Kermit_Send_Init *) Packet_Num := 0; Try := 0; Quoting := FALSE; His_Chk_Type := '1'; (* 8-bit quoting off for 8,n,1 *) (* and ascii file type transfers *) IF ( ( Parity <> 'N' ) OR ( Data_Bits <> 8 ) ) AND ( Kermit_File_Type_Var = Kermit_Binary ) THEN BEGIN Quote_8 := Kermit_Quote_8_Char; Quoting := TRUE; END ELSE (* Willing to quote if necessary *) Quote_8 := 'Y'; (* If repeating data to be allowed *) (* (not yet in PibTerm) *) IF Repeating THEN Repeat_Char := Kermit_Repeat_Char ELSE Repeat_Char := ' '; (* Construct initialization packet *) Packet_Buffer_Data := 'S' + Kermit_Char40( Kermit_Packet_Size ) + Kermit_Char40( Kermit_TimeOut ) + Kermit_Char40( Kermit_Npad ) + Kermit_Ctrl ( Kermit_Pad_Char ) + Kermit_Char40( ORD( Kermit_EOL ) ) + Kermit_Quote_Char + Quote_8 + Kermit_Chk_Type + Repeat_Char; Build_Packet; REPEAT (* Ensure type 1 block check here *) His_Chk_Type := '1'; (* Assume bad until proved otherwise *) ACK_OK := FALSE; (* Send initialization packet *) Send_Packet; (* Check response *) Receive_Packet; (* If right response then check *) (* if received packet jives *) (* with what we sent. *) IF ( Packet_OK AND ( Kermit_Packet_Type = ACK_Pack ) AND ( NOT Kermit_Abort ) ) THEN Check_Init( ACK_OK ); (* Increment count of tries *) Try := Try + 1; UNTIL ACK_OK OR Kermit_Abort OR ( Try = Kermit_MaxTry ); (* If OK, then get ready to send *) (* file header packet, else abort *) IF ACK_OK THEN Kermit_State := Send_File_Header ELSE Kermit_Abort := TRUE; END (* Kermit_Send_Init *); (*----------------------------------------------------------------------*) (* Build_And_Send_Packet_With_Retry --- Build & send packet with retry *) (*----------------------------------------------------------------------*) PROCEDURE Build_And_Send_Packet_With_Retry; (*----------------------------------------------------------------------*) (* *) (* Procedure: Build_And_Send_Packet_With_Retry *) (* *) (* Purpose: Sends packet to remote Kermit and retries if *) (* packet not acknowledged. *) (* *) (* Calling Sequence: *) (* *) (* Build_And_Send_Packet_With_Retry; *) (* *) (* *) (* Calls: *) (* *) (* Build_Packet *) (* Check_ACK *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Build_And_Send_Packet_With_Retry *) (* Build the packet *) Build_Packet; (* No tries yet *) Try := 0; (* Begin loop over sending tries *) REPEAT (* Send the packet *) Send_Packet; (* See if it was acknowledged *) Check_ACK; (* Increment count of send packet tries *) Try := Try + 1; (* Stop if OK, abort requested, or too *) (* many tries. *) UNTIL ACK_OK OR Kermit_Abort OR ( Try = Kermit_MaxTry ); END (* Build_And_Send_Packet_With_Retry *); (*----------------------------------------------------------------------*) (* Kermit_Send_Header --- send file header (file name) packet *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_Header; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_Header *) (* *) (* Purpose: Sends file name packet to remote Kermit. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_Header; *) (* *) (* Calls: *) (* *) (* Build_And_Send_Packet_With_Retry *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Kermit_Send_Header *) (* Construct file name packet *) Packet_Num := Packet_Num + 1; Packet_Buffer_Data := 'F' + FileName; (* Send the packet *) Build_And_Send_Packet_With_Retry; (* If it was ACKed, then *) (* prepare to send file. *) IF ACK_OK THEN Kermit_State := Send_File ELSE Kermit_Abort := TRUE; END (* Kermit_Send_Header *); (*----------------------------------------------------------------------*) (* Kermit_Send_File --- send file data itself *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_File *) (* *) (* Purpose: Sends file data packets to remote Kermit. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_File; *) (* *) (* Calls: *) (* *) (* Build_And_Send_Packet_With_Retry *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Kermit_Send_File *) (* Send file packets until entire *) (* file is sent OR transfer aborts *) Display_Kermit_Message('Sending...'); REPEAT (* Increment packet number *) Packet_Num := Packet_Num + 1; (* Get next block of data from file *) Get_File_Data; (* Construct and send data packet *) Build_And_Send_Packet_With_Retry; UNTIL File_Done OR Kermit_Abort; (* If entire file done, prepare to send *) (* EOF packet. *) IF File_Done THEN Kermit_State := Send_EOF; END (* Kermit_Send_File *); (*----------------------------------------------------------------------*) (* Kermit_Send_EOF --- send end of file packet *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_EOF; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_EOF *) (* *) (* Purpose: Sends end of file packet to remote Kermit marking *) (* no more data in current file being transferred. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_EOF; *) (* *) (* Calls: *) (* *) (* Build_And_Send_Packet_With_Retry *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Kermit_Send_EOF *) (* Prepare EOF packet *) Packet_Num := ( Packet_Num + 1 ) MOD 64; Packet_Buffer_Data := EOF_Packet; (* Send EOF Packet *) Build_And_Send_Packet_With_Retry; (* If OK then prepare to try *) (* for another file, if any *) IF ACK_OK THEN Kermit_State := Send_Break ELSE Kermit_Abort := TRUE; END (* Kermit_Send_EOF *); (*----------------------------------------------------------------------*) (* Kermit_Send_Break --- send break packet *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_Break; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_Break *) (* *) (* Purpose: Sends break packet to remote Kermit. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_Break; *) (* *) (* Calls: *) (* *) (* Build_And_Send_Packet_With_Retry *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Kermit_Send_Break *) (* Construct break packet *) Kermit_State := Send_Break; Packet_Num := ( Packet_Num + 1 ) MOD 64; Packet_Buffer_Data := Break_Packet; (* Send the break packet *) Build_And_Send_Packet_With_Retry; (* If OK, then sending of file complete *) IF ACK_OK THEN Send_Done := TRUE ELSE Kermit_Abort := TRUE; END (* Kermit_Send_Break *); (*----------------------------------------------------------------------*) (* Kermit_Send_One_File --- Controls sending of a single file *) (*----------------------------------------------------------------------*) PROCEDURE Kermit_Send_One_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: Kermit_Send_One_File *) (* *) (* Purpose: Sends a single file to remote Kermit. *) (* *) (* Calling Sequence: *) (* *) (* Kermit_Send_One_File; *) (* *) (* Calls: *) (* *) (* Draw_Menu_Frame *) (* Initialize_Send_Display *) (* Open_File *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Kermit_Send_One_File *) (* Open file transfer display window *) Window( 1, 1, 80, 25 ); Menu_Title := 'Send file ' + FileName + ' using Kermit'; Draw_Menu_Frame( 15, 10, 78, 21, Menu_Frame_Color, Menu_Text_Color, Menu_Title ); Window( 16, 11, 77, 20 ); (* Display send titling information *) Initialize_Send_Display; (* Display init packet parameters *) Display_Kermit_Init_Params; (* Try opening file to be sent *) Open_File( Read_Open, FileName ); (* If open went OK, then do transfer. *) IF ( Open_OK ) THEN BEGIN (* Ensure record read first time by *) (* pointing buffer pointer past end *) (* of file buffer. *) Buffer_Pos := Buffer_Size + 1; (* Loop over states in transfer until *) (* transfer aborted OR file is completely *) (* sent. *) REPEAT CASE Kermit_State OF Send_Init : Kermit_Send_Init; Send_File_Header : Kermit_Send_Header; Send_File : Kermit_Send_File; Send_EOF : Kermit_Send_EOF; Send_Break : Send_Done := TRUE; END (* CASE *); UNTIL ( Kermit_Abort OR Send_Done ); IF Send_Done THEN Display_Kermit_Message('Completed.') ELSE Display_Kermit_Message('Kermit Aborted.'); END (* IF Open_OK *); END (* Kermit_Send_One_File *); (*----------------------------------------------------------------------*) (* Do_Kermit_Send --- Controls sending of list of files in Kermit *) (*----------------------------------------------------------------------*) PROCEDURE Do_Kermit_Send; (*----------------------------------------------------------------------*) (* *) (* Procedure: Do_Kermit_Send *) (* *) (* Purpose: Controls sending of list of files in Kermit *) (* *) (* Calling Sequence: *) (* *) (* Do_Kermit_Send; *) (* *) (* Calls: *) (* *) (* Save_Screen *) (* Restore_Screen *) (* Initialize_Send_Display *) (* Display_Kermit_Message *) (* Dir_Find_First_File *) (* Dir_Find_Next_File *) (* Get_Kermit_File_Name *) (* Kermit_Send_One_File *) (* Reset_Global_Colors *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Do_Kermit_Send *) (* Open display window for transfer *) Save_Screen( Local_Save ); (* Initialize status display information *) Packets_Sent := 0; Packets_Received := 0; Packets_Bad := 0; Buffer_Num := 0.0; Kermit_MaxTry := 5; (* Prepare Kermit to send initialization *) (* packet. *) Kermit_State := Send_Init; (* Display transfer headings *) Initialize_Send_Display; (* See if we can find anything to *) (* be sent. *) Stop_Send := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 ); IF Stop_Send THEN BEGIN Display_Kermit_Message(' No files found to send.'); DELAY( Two_Second_Delay ); END ELSE (* Wait for delay time to expire in *) (* host mode. *) IF Host_Mode THEN DELAY( 1000 * Kermit_Delay_Time ); (* Allocate buffer if requested *) (* otherwise use sector data area *) (* directly. *) IF Max_Write_Buffer > 1024 THEN BEGIN Buffer_Length := Max_Write_Buffer; Long_Buffer := TRUE; GetMem( Read_Buffer , Buffer_Length ); END ELSE BEGIN Long_Buffer := FALSE; Read_Buffer := ADDR( Sector_Data ); END; (* Loop over file names *) WHILE( NOT Stop_Send ) DO BEGIN (* Initialize *) Send_Done := FALSE; File_Done := FALSE; Kermit_Abort := FALSE; Kermit_Retry := FALSE; Buffer_Size := Buffer_Length; (* Get file name *) Get_Kermit_File_Name( OK_File ); (* If file can be sent, do it *) IF OK_File THEN BEGIN Kermit_Send_One_File; Kermit_State := Send_File_Header; END; (* See if more files to transfer *) Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 ); (* Send break packet if no more files *) IF Stop_Send THEN Kermit_Send_Break; END (* WHILE *); (* Remove download buffer *) IF Long_Buffer THEN FREEMEM( Read_Buffer , Buffer_Length ); (* Remove Kermit window *) Restore_Screen( Local_Save ); Reset_Global_Colors; END (* Do_Kermit_Send *); (*----------------------------------------------------------------------*) (* Get_File_Pattern --- get wildcard specification for files to send *) (*----------------------------------------------------------------------*) PROCEDURE Get_File_Pattern; BEGIN (* Get_File_Pattern *) GoToXY( 2 , 6 ); WRITE('File to send: '); IF ( NOT Host_Mode ) THEN READLN( File_Pattern ) ELSE BEGIN WRITE( FileName ); File_Pattern := FileName; END; END (* Get_File_Pattern *); (*----------------------------------------------------------------------*) BEGIN (* Send_Kermit_File *) (* Save current screen *) Save_Screen( Local_Save_2 ); (* Get Kermit menu *) WITH Kermit_Menu DO BEGIN Menu_Size := 4; Menu_Default := 1; Menu_Row := 11; Menu_Column := 20; Menu_Tcolor := Menu_Text_Color; Menu_Bcolor := BackGround_Color; Menu_Fcolor := Menu_Frame_Color; Menu_Width := 40; Menu_Height := 10; END (* WITH Kermit_Menu *); FOR I := 1 TO 4 DO WITH Kermit_Menu.Menu_Entries[I] DO BEGIN Menu_Item_Row := I; Menu_Item_Column := 2; CASE I OF 1: Menu_Item_Text := 'a) Send Text File'; 2: Menu_Item_Text := 'b) Send Binary File'; 3: Menu_Item_Text := 'L) Logout Remote Server'; 4: Menu_Item_Text := 'Q) Quit Kermit'; END (* CASE *); END; Kermit_Menu.Menu_Title := 'Choose Kermit function: '; Kermit_Done := FALSE; Sending_File := TRUE; Host_Count := 0; (* Begin loop over send choices *) REPEAT (* Reinitialize global Kermit variables *) Kermit_Init; (* Display send menu *) IF ( NOT Host_Mode ) THEN BEGIN Menu_Display_Choices( Kermit_Menu ); Menu_Choice := Menu_Get_Choice( Kermit_Menu , Dont_Erase_Menu ); END ELSE BEGIN Host_Count := Host_Count + 1; IF ( Host_Count = 1 ) THEN IF Kermit_File_Type_Var <> Kermit_Binary THEN Menu_Choice := 1 ELSE Menu_Choice := 2 ELSE Menu_Choice := 4; END; (* Choose function to perform *) CASE Menu_Choice OF 1: BEGIN (* Send Ascii text file *) Kermit_File_Type_Var := Kermit_Ascii; Get_File_Pattern; IF LENGTH( File_Pattern ) > 0 THEN Do_Kermit_Send; END; 2: BEGIN (* Send binary file *) Kermit_File_Type_Var := Kermit_Binary; Get_File_Pattern; IF LENGTH( File_Pattern ) > 0 THEN Do_Kermit_Send; END; (* Logout remote Kermit server *) 3: Kermit_Finish_Server; (* Stop sends *) 4: Kermit_Done := TRUE; END (* CASE *); UNTIL Kermit_Done; Restore_Screen( Local_Save_2 ); Reset_Global_Colors; END (* Send_Kermit_File *);